home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / gsdbloo.exe / DEMOU002.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-20  |  3.1 KB  |  133 lines
  1. Program DemoU002;
  2. {------------------------------------------------------------------------------
  3.                           DBase File and Memo Builder
  4.                                 Useless Example
  5.                                   Demo Program
  6.  
  7.        Copyright (c)  Richard F. Griffin
  8.  
  9.        20 February 1992
  10.  
  11.        102 Molded Stone Pl
  12.        Warner Robins, GA  31088
  13.  
  14.        -------------------------------------------------------------
  15.        This program creates a dBase file 'MYFILE.DBF with memo file
  16.        'MYFILE.DBT'.
  17.  
  18. -------------------------------------------------------------------------------}
  19. uses
  20.    CRT,
  21.    DOS,
  22.    GS_Date,
  23.    GS_Strng,
  24.    GS_MakMo,
  25.    GS_dBase,
  26.    GS_dBFld,
  27.    GS_dB3Wk;
  28.  
  29. type
  30.    FldRecPtr   = ^FldRecTyp;
  31.    FldRecTyp   = array[1..GS_dBase_MaxRecField] of GS_dBase_Field;
  32.  
  33. var
  34.    fli : text;
  35.    s   : string;
  36.    i   : integer;
  37.  
  38.    gfMemoColl : GS_MakeMemoP;
  39.    gfLineName  : string[12];
  40.    gfBirthDate : string[8];
  41.    gfRandomNum : string[12];
  42.  
  43.    f : FldRecPtr;
  44.    t : string;
  45.    FLoc : integer;
  46.  
  47.    dbx : GSP_dBFld_Objt;
  48.  
  49. procedure InsertField(s : string; t : char; l,d : integer);
  50. begin
  51.    if FLoc >= GS_dBase_MaxRecField then exit;
  52.    inc(FLoc);
  53.    s := AllCaps(s);
  54.    CnvStrToAsc(s,f^[FLoc].FieldName,11);
  55.    f^[FLoc].FieldType := t;
  56.    f^[FLoc].FieldLen := l;
  57.    f^[FLoc].FieldDec := d;
  58.    f^[FLoc].FieldAddress := 0;
  59.    FillChar(f^[FLoc].Reserved,20,#0);
  60. end;
  61.  
  62. Function RandString(l,h : integer) : string;
  63. var
  64.    v : integer;
  65.    g : string;
  66. begin
  67.    v := random((h-l)+1);
  68.    v := v + l;
  69.    str(v,g);
  70.    RandString := g;
  71. end;
  72.  
  73. procedure BuildRecordData;
  74. var
  75.    k1  : word;
  76.    s1  : string[5];
  77. begin
  78.    str(i, gfLineName);
  79.    gfLineName := 'Line ' + gfLineName;
  80.    k1 := random(25);
  81.    gfBirthDate := GS_Date_dBStor(GS_Date_Curr - k1);
  82.    k1 := random(2);
  83.    if k1 = 0 then gfRandomNum := '-' else gfRandomNum := '';
  84.    s1 := RandString(0,30000);
  85.    while length(s1) < 5 do s1 := s1+'0';
  86.    gfRandomNum := gfRandomNum + RandString(0,30000) + '.' + s1;
  87.    while length(gfRandomNum) < 12 do gfRandomNum := ' ' + gfRandomNum;
  88.    gfMemoColl^.ResetMemoData;
  89.    readln(fli, s);
  90.    gfMemoColl^.InsertMemoData(s+#13#10);
  91. end;
  92.  
  93.  
  94. {--- Main Program ---}
  95.  
  96. begin
  97.            {Create new dBase file}
  98.  
  99.    New(f);
  100.    FLoc := 0;
  101.    InsertField('LINENAME','C',30,0);
  102.    InsertField('BIRTHDATE','D',8,0);
  103.    InsertField('RANDOMNUM','N',12,5);
  104.    InsertField('COMMENTS','M',10,0);
  105.    GS_dB3_Build('MyFile',f,FLoc);
  106.    dispose(f);
  107.  
  108.            {Add records to the file}
  109.  
  110.    New(dbx, Init('MyFile'));
  111.    dbx^.Open;
  112.    gfMemoColl := New (GS_MakeMemoP, Init(dbx,8192));
  113.    randomize;
  114.    assign(fli,'wisdom.fil');
  115.    reset(fli);
  116.    for i := 1 to 20 do
  117.    begin
  118.       BuildRecordData;
  119.       dbx^.Blank;
  120.       dbx^.FieldPut('LINENAME',gfLineName);
  121.       dbx^.FieldPut('BIRTHDATE',gfBirthDate);
  122.       dbx^.FieldPut('RANDOMNUM',gfRandomNum);
  123.       dbx^.FieldPut('COMMENTS',gfMemoColl^.WriteMemoRecord);
  124.       dbx^.Append;
  125.    end;
  126.  
  127.            {Dispose of objects (also closes the files}
  128.  
  129.    Dispose(gfMemoColl, Done);
  130.    Dispose(dbx, Done);
  131.    close(fli);
  132. end.
  133.